home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / CRYSFILT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-28  |  3.9 KB  |  146 lines
  1. 10  'CRYSFILT - Crystal Ladder Filters - 01 FEB 96 rev. 27 SEP 96
  2. 20  IF EX$=""THEN EX$="EXIT"
  3. 30  CLS:KEY OFF
  4. 40  COLOR 7,0,1
  5. 50  U1$="#####.###"
  6. 60  X$=STRING$(80,32)
  7. 70  DIM BK(5,5),CK(5,5)
  8. 80  '
  9. 90  DATA 1.414, .7071, 0, 0, 0
  10. 100  DATA 1, .7071, .7071, 0, 0
  11. 110  DATA .7654, .8409, .4512, .8409, 0
  12. 120  DATA .6180, 1, .5559, .5559, 1
  13. 130  '
  14. 140  DATA 1.6382, .7106, 0, 0, 0
  15. 150  DATA 1.4328, .6618, .6618, 0, 0
  16. 160  DATA 1.3451, .685, .5421, .685, 0
  17. 170  DATA 1.3013, .7028, .5355, .5355, .7028
  18. 180  '
  19. 190  FOR Z=2 TO 5:FOR Y=1TO 5:READ BK(Z,Y):NEXT Y:NEXT Z
  20. 200  FOR Z=2 TO 5:FOR Y=1 TO 5:READ CK(Z,Y):NEXT Y:NEXT Z
  21. 210  GOTO 290
  22. 220  '
  23. 230  '.....format input line
  24. 240  IF ZZ=N THEN U$="#####"ELSE U$=U1$
  25. 250  LOCATE CSRLIN-1:PRINT SPC(7);
  26. 260  LOCATE CSRLIN,47:PRINT STRING$(7,".");USING U$;ZZ;
  27. 270  RETURN
  28. 280  '
  29. 290  '.....start
  30. 300  CLS
  31. 310  COLOR 15,2
  32. 320  PRINT " CRYSTAL LADDER FILTER";TAB(57)"by George Murphy VE3ERP ";
  33. 330  COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
  34. 340  GOSUB 1020    'diagram
  35. 350  PRINT
  36. 360  GOSUB 1150   'preface
  37. 370  PRINT
  38. 380  COLOR 0,7:LOCATE ,21:PRINT " Press 1 to continue or 0 to EXIT..."
  39. 390  COLOR 7,0
  40. 400  Z$=INKEY$:IF Z$=""THEN 400
  41. 410  IF Z$="0"THEN CLS:RUN EX$
  42. 420  IF Z$="1"THEN 440
  43. 430  GOTO 400
  44. 440  VIEW PRINT 11 TO 24:CLS:VIEW PRINT:LOCATE 11
  45. 450  '
  46. 460  '.....inputs
  47. 470  INPUT " ENTER: Matched crystal BANDWIDTH................(Hz)";F
  48. 480  ZZ=F:GOSUB 230:PRINT " Hz"
  49. 490  '
  50. 500  INPUT " ENTER: Matched crystal CENTRE FREQUENCY........(MHz)";FO
  51. 510  ZZ=FO:GOSUB 230:PRINT " MHz"
  52. 520  '
  53. 530  INPUT " ENTER: Matched crystal SERIES-LOSS RESISTANCE....(-)";FS
  54. 540  ZZ=FS:GOSUB 230:PRINT " ohms"
  55. 550  '
  56. 560  COLOR 0,7:LOCATE ,8
  57. 570  PRINT " Choose filter: Press b for Butterworth or c for Chebyshev."
  58. 580  COLOR 7,0
  59. 590  F$=INKEY$:IF F$=""THEN 590
  60. 600  IF F$="b"THEN TYPE$="BUTTERWORTH":GOTO 630
  61. 610  IF F$="c"THEN TYPE$="CHEBYSHEV":GOTO 630
  62. 620  GOTO 590
  63. 630  LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1,2
  64. 640  COLOR 0,7:PRINT " ";TYPE$;" FILTER:":COLOR 7,0
  65. 650  '
  66. 660  INPUT " ENTER: Number of poles (maximum 5)..................";N
  67. 670  IF N>5 THEN LOCATE CSRLIN-1:PRINT X$;:LOCATE CSRLIN-1:GOTO 660
  68. 680  ZZ=N:GOSUB 230:PRINT ""
  69. 690  '
  70. 700  INPUT " ENTER: Desired filter bandwidth.................(Hz)";B
  71. 710  ZZ=B:GOSUB 230:PRINT " Hz"
  72. 720  '
  73. 730  CN=1    'capacitor number
  74. 740  FOR Z=2 TO N
  75. 750  IF F$="b"THEN KJK=BK(N,Z)
  76. 760  IF F$="c"THEN KJK=CK(N,Z)
  77. 770  CJK=1326*(F/(B*KJK*FO))-10
  78. 780  CN=CN+11:CN$="C"+RIGHT$(STR$(CN),2)
  79. 790  PRINT "        Capacitor ";CN$;"................................";
  80. 800  PRINT USING U1$;CJK;:PRINT " pF"
  81. 810  NEXT Z
  82. 820  '
  83. 830  IF F$="b"THEN Q=BK(N,1)
  84. 840  IF F$="c"THEN Q=CK(N,1)
  85. 850  RE=(120*B/(Q*294))-23
  86. 860  PRINT "        Minimum End Resistance required..............";USING U1$;RE;
  87. 870  PRINT " ohms"
  88. 880  '
  89. 890  PRINT " ENTER: End Termination Ro (minimum";USING "####.#";RE+0.1;
  90. 900  PRINT " -)...(ohms)";:INPUT RO
  91. 910  ZZ=RO:GOSUB 230:PRINT " ohms"
  92. 920  '
  93. 930  CEND=(1.59*10^5/(RO*FO))*SQR(RO/RE-1)-5
  94. 940  PRINT "        End Capacitors (Ce)..........................";
  95. 950  PRINT USING U1$;CEND;:PRINT " pF"
  96. 960  '
  97. 970  '.....end
  98. 980  GOSUB 1330
  99. 990  GOTO 290
  100. 1000  END
  101. 1010  '
  102. 1020  '.....diagram
  103. 1030  T=9
  104. 1040  COLOR 0,7
  105. 1050  LOCATE ,T:PRINT "         VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND matched crystals SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR         "
  106. 1060  LOCATE ,T:PRINT "           VARPTRSOUNDCOLOR     VARPTRSOUNDCOLOR     VARPTRSOUNDCOLOR     VARPTRSOUNDCOLOR     VARPTRSOUNDCOLOR           "
  107. 1070  LOCATE ,T:PRINT "  VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDBSAVESOUND<0xB4!>CALL1CALLBLOADSOUNDBSAVESOUND<0xB4!>CALL2CALLBLOADSOUNDBSAVESOUND<0xB4!>CALL3CALLBLOADSOUNDBSAVESOUND<0xB4!>CALL4CALLBLOADSOUNDBSAVESOUND<0xB4!>CALL5CALLBLOADSOUNDBSAVESOUNDSOUNDSOUNDSOUNDSOUNDCOLOR  "
  108. 1080  LOCATE ,T:PRINT "  CALL     CALL  CLSSOUND'  CALL  CLSSOUND'  CALL  CLSSOUND'  CALL  CLSSOUND'  CALL  CLSSOUND'  CALL     CALL  "
  109. 1090  LOCATE ,T:PRINT " Ro    THENINSTRTHENCe   THENINSTRTHENC12  THENINSTRTHENC23  THENINSTRTHENC34  THENINSTRTHENC45  THENINSTRTHENCe  Ro "
  110. 1100  LOCATE ,T:PRINT "  CALL     CALL       CALL       CALL       CALL       CALL       CALL     CALL  "
  111. 1110  LOCATE ,T:PRINT "  CLSSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDMOTORSOUNDSOUNDSOUNDSOUNDSOUND'  "
  112. 1120  COLOR 7,0
  113. 1130  RETURN
  114. 1140  '
  115. 1150  '.....preface
  116. 1160  T=7
  117. 1170  PRINT TAB(T);
  118. 1180  PRINT "An in-depth discussion of Crystal Ladder Filters appears in the"
  119. 1190  PRINT TAB(T);
  120. 1200  PRINT "A.R.R.L. publication ";CHR$(34);"W1FB's DESIGN NOTEBOOK";CHR$(34);
  121. 1210  PRINT ", starting on page"
  122. 1220  PRINT TAB(T);
  123. 1230  PRINT "179, from an original paper by Wes Hayward, W7ZOI, in the May 1982"
  124. 1240  PRINT TAB(T);
  125. 1250  PRINT "QST, page 21."
  126. 1260  PRINT
  127. 1270  PRINT TAB(T);
  128. 1280  PRINT "This program solves the equations presented in these articles, and"
  129. 1290  PRINT TAB(T);
  130. 1300  PRINT "may also be used as a stand-alone filter design tool."
  131. 1310  RETURN
  132. 1320  '
  133. 1330  'HARDCOPY
  134. 1340  GOSUB 1450:LOCATE 25,2:COLOR 14,6
  135. 1350  PRINT " Press 1 to print screen, 2 to print screen & ";
  136. 1360  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  137. 1370  Z$=INKEY$:IF Z$="3"THEN GOSUB 1450:RETURN
  138. 1380  IF Z$="1"OR Z$="2"THEN GOSUB 1450:GOTO 1400
  139. 1390  GOTO 1370
  140. 1400  FOR QX=1 TO 24:FOR QY=1 TO 80
  141. 1410  LPRINT CHR$(SCREEN(QX,QY));
  142. 1420  NEXT QY:NEXT QX
  143. 1430  IF Z$="2"THEN LPRINT CHR$(12)
  144. 1440  GOTO 1340
  145. 1450  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  146.